home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / SHORTDIP.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-03-10  |  5.9 KB  |  203 lines
  1. 10  'SHORTDIP - Short Multiband Dipoles - 29 DEC 95 rev. 10 MAR 97
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  PROG$="shortdip"
  4. 40  COMMON EX$,PROG$,LX      'note:lx=lg
  5. 50  CLS:KEY OFF
  6. 60  COLOR 7,0,1
  7. 70  PI=3.14159
  8. 80  UL$=STRING$(80,205)
  9. 90  U$="###.##"
  10. 100  DIM FQ(9,2)
  11. 110  '
  12. 120  DATA 160,80,40,30,20,17,15,12,10
  13. 130  DATA 1.9, 3.75, 7.15,10.125, 14.175, 18.118, 21.225, 24.94, 28.85
  14. 140  FOR Z=1 TO 9:READ FQ(Z,1):NEXT Z
  15. 150  FOR Z=1 TO 9:READ FQ(Z,2):NEXT Z
  16. 160  '
  17. 170  '.....start
  18. 180  CLS
  19. 190  COLOR 15,2
  20. 200  PRINT " SHORT MULTIBAND DIPOLE ARRAY";
  21. 210  PRINT TAB(57)"by George Murphy VE3ERP ";
  22. 220  COLOR 1,0:PRINT STRING$(80,223);
  23. 230  COLOR 7,0
  24. 240  GOSUB 1470     'diagram
  25. 250  PRINT UL$;
  26. 260  GOSUB 1640     'preface
  27. 270  PRINT UL$;
  28. 280  PRINT TAB(T)"Press 1 to RUN program or 0 to EXIT.....";
  29. 290  Z$=INKEY$:IF Z$=""THEN 290
  30. 300  IF Z$="1"THEN 340
  31. 310  IF Z$="0"THEN CLS:RUN EX$
  32. 320  GOTO 290
  33. 330  '
  34. 340  VIEW PRINT 15 TO 24:CLS:VIEW PRINT:LOCATE 15
  35. 350  PRINT " Press number in < > to choose standard units of measure:"
  36. 360  PRINT UL$;
  37. 370  PRINT "   < 1 >  Metric"
  38. 380  PRINT "   < 2 >  U.S.A./Imperial"
  39. 390  Z$=INKEY$:IF Z$=""THEN 390
  40. 400  IF Z$="1"THEN M$=" m.":W$=" ^ 2 mm ":UM=0.3048:GOTO 440
  41. 410  IF Z$="2"THEN M$=" ft":W$=" AWG 12 ":UM=1:GOTO 440
  42. 420  GOTO 390
  43. 430  '
  44. 440  VIEW PRINT 15 TO 24:CLS:VIEW PRINT:LOCATE 15
  45. 450  IF LG=0 THEN LIN=15:GOTO 580
  46. 460  PRINT " Press number in < > to:"
  47. 470  PRINT UL$;
  48. 480  PRINT "   < 3 >  Select another length 'A'"
  49. 490  PRINT "   < 4 >  Run Detail Design program"
  50. 500  PRINT
  51. 510  PRINT "   < 0 >  EXIT"
  52. 520  Z$=INKEY$:IF Z$=""THEN 520
  53. 530  IF Z$="3"THEN LIN=13:GOTO 580
  54. 540  IF Z$="4"THEN CLS:LX=LG:CHAIN"shortant"
  55. 550  IF Z$="0"THEN CLS:RUN EX$
  56. 560  GOTO 520
  57. 570  '
  58. 580  '.....notes
  59. 590  VIEW PRINT LIN TO 24:CLS:VIEW PRINT:LOCATE LIN
  60. 600  T=7
  61. 610  PRINT TAB(T);
  62. 620  PRINT "These antennas will perform very well at modest heights when 'A' is"
  63. 630  PRINT TAB(T);
  64. 640  PRINT "longer than 1/5 wavelength for the band of operation. At lengths"
  65. 650  PRINT TAB(T);
  66. 660  PRINT "below this threshold an antenna will still work but its efficiency"
  67. 670  PRINT TAB(T);
  68. 680  PRINT "(rated 'Fair' by this program) begins to approach that of a typical"
  69. 690  PRINT TAB(T);
  70. 700  PRINT "inductively loaded mobile whip antenna."
  71. 710  PRINT
  72. 720  PRINT TAB(T);
  73. 730  PRINT "Extremely short antennas for the lower HF bands may require loading"
  74. 740  PRINT TAB(T);
  75. 750  PRINT "coils so large that the antenna may become physically impractical."
  76. 760  PRINT UL$;
  77. 770  PRINT " ENTER: Available space A (";M$;" ).......";:INPUT LG
  78. 780  LG=LG/UM
  79. 790  CLS:GOSUB 1470
  80. 800  B=0.9*LG/2           'dimension B
  81. 810  DIA=0.0808081    'wire diameter
  82. 820  COLOR 0,7
  83. 830  LOCATE 2,34:PRINT " A=";USING U$;LG*UM;:PRINT M$+" "
  84. 840  LOCATE 3,24:PRINT USING U$;LG/2*UM;:PRINT M$+" "
  85. 850  LOCATE 4,27:PRINT USING U$;B*UM;:PRINT M$+" "
  86. 860  COLOR 7,0:LOCATE 12
  87. 870  PRINT UL$;
  88. 880  LOCATE CSRLIN-1,8:PRINT "FN"
  89. 890  LOCATE CSRLIN-1,21:PRINT "FN"
  90. 900  LOCATE CSRLIN-1,55:PRINT "FN"
  91. 910  LOCATE CSRLIN-1,31:PRINT W$;"WIRE DIPOLES "
  92. 920  '
  93. 930  PRINT TAB(8)"CALL";TAB(21)"CALL  Dipole";
  94. 940  PRINT TAB(32)"CALLEfficiencyCALL";TAB(46)"Loading";TAB(55)"CALL";TAB(63)"EFFICIENCY"
  95. 950  PRINT TAB(3)"Band CALL";TAB(13)"MHz";TAB(21)"CALL  Length";TAB(32)"CALLThreshold CALL";
  96. 960  PRINT TAB(46)"Coils L";TAB(55)"CALL Excellent   Good   Fair"
  97. 970  PRINT UL$;
  98. 980  LOCATE CSRLIN-1,8:PRINT "STEP"
  99. 990  LOCATE CSRLIN-1,21:PRINT "STEP"
  100. 1000  LOCATE CSRLIN-1,32:PRINT "STEP"
  101. 1010  LOCATE CSRLIN-1,43:PRINT "STEP"
  102. 1020  LOCATE CSRLIN-1,55:PRINT "INSTR"
  103. 1030  '
  104. 1040  '.....calculate & print
  105. 1050  FOR Z=1 TO 9
  106. 1060  F=FQ(Z,2)
  107. 1070  WL=491.787/F        '1/2 wavelength in free space, in feet
  108. 1080  RA=WL*12/DIA           'ratio of 1/2 wavelength to wire diameter
  109. 1090  K=0.91
  110. 1100  IF RA>10 THEN K=0.92
  111. 1110  IF RA>12 THEN K=0.93
  112. 1120  IF RA>15 THEN K=0.94
  113. 1130  IF RA>22 THEN K=0.95
  114. 1140  IF RA>50 THEN K=0.96
  115. 1150  IF RA>200 THEN K=0.97
  116. 1160  IF RA>2000 THEN K=0.98
  117. 1170  HW=492*K/F      'length of half wave flat top, in feet
  118. 1180  HW=0.95*HW/K     'end effect correction for f<30MHz
  119. 1190  SP=300/F*0.656          'minimum dimension A
  120. 1200   F1=10^6/(68*PI^2*F^2)
  121. 1210   F2=LOG((24*(234/F)-B)/DIA-1)
  122. 1220   F3=(1-F*B/234)^2-1
  123. 1230   F4=234/F-B
  124. 1240   F5=LOG((24*LG/2-B)/DIA-1)
  125. 1250   F6=((F*LG/2-F*B)/234)^2-1
  126. 1260   F7=LG/2-B
  127. 1270  L=F1*(F2*F3/F4-F5*F6/F7)
  128. 1280  IF HW<LG THEN L=0
  129. 1290  PRINT USING "####";FQ(Z,1);:PRINT " m.";    'band
  130. 1300  PRINT USING "####.###";F;:PRINT " MHz";     'frequency
  131. 1310  IF L>0 THEN PRINT USING "#####.##";LG*UM;:PRINT M$;:GOTO 1340
  132. 1320  PRINT USING "#####.##";HW*UM;:PRINT M$;     '1/2 wave
  133. 1330  IF L=0 THEN PRINT TAB(37)"-";:GOTO 1350
  134. 1340  PRINT USING "#####.##";SP*UM;:PRINT M$;     'A threshold
  135. 1350  IF L=0 THEN PRINT TAB(47)"none    CALL";:GOTO 1370
  136. 1360  PRINT USING "#######.#";L;:PRINT " >H CALL";   'inductance
  137. 1370  IF LG<SP THEN COLOR 0,7:LOCATE CSRLIN,76:PRINT "[<UNK! {00FB}>]";:GOTO 1420
  138. 1380  IF L<>0 THEN 1410
  139. 1390  COLOR 0,7:LOCATE CSRLIN,58:PRINT "[<UNK! {00FB}>]";
  140. 1400  COLOR 7,0:LOCATE CSRLIN,62:PRINT "(full size dipole)";:GOTO 1420
  141. 1410  COLOR 0,7:LOCATE CSRLIN,69:PRINT "[<UNK! {00FB}>]";
  142. 1420  COLOR 7,0:IF CSRLIN<24 THEN PRINT ""
  143. 1430  NEXT Z
  144. 1440  GOTO 1840   'end
  145. 1450  END
  146. 1460  '
  147. 1470  '.....diagram
  148. 1480  COLOR 0,7
  149. 1490  T=12
  150. 1500  LOCATE ,T:PRINT "                                                         "
  151. 1510  LOCATE ,T:PRINT "    CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND A SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL    "
  152. 1520  LOCATE ,T:PRINT "    CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND A/2 SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL                       CALL    "
  153. 1530  LOCATE ,T:PRINT "    CALL     CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUND B SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL  loading coils LSOUNDCOLOR    CALL    "
  154. 1540  LOCATE ,T:PRINT " - -/SOUNDSOUNDSOUNDORORORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVE/BSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDORORORSOUNDSOUNDSOUND/- - "
  155. 1550  LOCATE ,T:PRINT " - -/SOUNDSOUNDSOUNDORORORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!> BLOADSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDORORORSOUNDSOUNDSOUND/- - "
  156. 1560  LOCATE ,T:PRINT " VARPTRSOUNDDEFDBL - - - -/-SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!> BLOADSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND-/- - - - - - "
  157. 1570  LOCATE ,T:PRINT " BLOADSOUNDDEFDBL - - - - - SOUND/SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORCOLORBLOADSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND/SOUND - - - - - - - "
  158. 1580  LOCATE ,T:PRINT " full size RENUM wave dipole(s) PRESET'                           "
  159. 1590  LOCATE ,T:PRINT "                            OPENDEFSNGSOUND 50-- COAX                "
  160. 1600  LOCATE ,T:PRINT "        Typical Configuration for Multiple Dipoles       "
  161. 1610  COLOR 7,0
  162. 1620  RETURN
  163. 1630  '
  164. 1640  '.....preface
  165. 1650  T=7
  166. 1660  PRINT TAB(T);
  167. 1670  PRINT "A simple and effective multiband antenna array may be made by"
  168. 1680  PRINT TAB(T);
  169. 1690  PRINT "connecting a number of parallel dipoles a few inches apart to a"
  170. 1700  PRINT TAB(T);
  171. 1710  PRINT "single low-impedance transmission line at a common feed point. Some"
  172. 1720  PRINT TAB(T);
  173. 1730  PRINT "or all of these dipoles can be electrically shortened to fit the"
  174. 1740  PRINT TAB(T);
  175. 1750  PRINT "space available by installing loading coils in the horizontal legs."
  176. 1760  PRINT TAB(T);
  177. 1770  PRINT "Use this program to plan your array, then use the detailed design"
  178. 1780  PRINT TAB(T);
  179. 1790  PRINT "option from the menu at the end of the program to design each of"
  180. 1800  PRINT TAB(T);
  181. 1810  PRINT "the inductively loaded dipoles in your array."
  182. 1820  RETURN
  183. 1830  '
  184. 1840  '.....end
  185. 1850  GOSUB 1900
  186. 1860  VIEW PRINT 12 TO 24:CLS:VIEW PRINT:LOCATE 12:PRINT UL$;
  187. 1870  GOTO 450   'menu
  188. 1880  END
  189. 1890  '
  190. 1900  'HARDCOPY
  191. 1910  GOSUB 2020:LOCATE 25,2:COLOR 14,6
  192. 1920  PRINT " Press 1 to print screen, 2 to print screen & ";
  193. 1930  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  194. 1940  Z$=INKEY$:IF Z$="3"THEN GOSUB 2020:RETURN
  195. 1950  IF Z$="1"OR Z$="2"THEN GOSUB 2020:GOTO 1970
  196. 1960  GOTO 1940
  197. 1970  FOR QX=1 TO 24:FOR QY=1 TO 80
  198. 1980  LPRINT CHR$(SCREEN(QX,QY));
  199. 1990  NEXT QY:NEXT QX
  200. 2000  IF Z$="2"THEN LPRINT CHR$(12)
  201. 2010  GOTO 1910
  202. 2020  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  203.